home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / infom < prev    next >
Text File  |  1993-08-16  |  7KB  |  241 lines
  1. #!/usr/local/bin/tclm -f
  2. #
  3. # Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions
  7. # are met:
  8. # 1. Redistributions of source code must retain the above copyright
  9. #    notice, this list of conditions and the following disclaimer.
  10. # 2. Redistributions in binary form must reproduce the above copyright
  11. #    notice, this list of conditions and the following disclaimer in the
  12. #    documentation and/or other materials provided with the distribution.
  13. # 3. All advertising materials mentioning features or use of this software
  14. #    must display the following acknowledgement:
  15. #    This product includes software developed by Michael B. Durian.
  16. # 4. The name of the the Author may be used to endorse or promote 
  17. #    products derived from this software without specific prior written 
  18. #    permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  21. # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  22. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  23. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31. #
  32.  
  33. # infom,v 1.2 1993/05/06 21:42:20 durian Exp
  34.  
  35. # get filename arg
  36. if {[string compare [lindex $argv 0] "-f"] == 0} {
  37.     incr argc -2
  38.     set argv [lrange $argv 2 end]
  39. }
  40.  
  41. case $argc in {
  42.     0 {
  43.         set infile_name stdin
  44.         set outfile_name stdout
  45.     } 1 {
  46.         set infile_name [lindex $argv 0]
  47.         set outfile_name stdout
  48.     } 2 {
  49.         set infile_name [lindex $argv 0]
  50.         set outfile_name [lindex $argv 1]
  51.     } default {
  52.         puts stderr "Usage: infom [info_file [midi_file]]"
  53.         exit 1
  54.     }
  55. }
  56.  
  57. proc PutEvent {event mfile track_num last_timing} {
  58.  
  59.     # get the timing part of the event
  60.     set timing [lindex $event 0]
  61.     # minus :
  62.     set timing [string trimright $timing :]
  63.  
  64.     #determine time since last event
  65.     set delta [expr {$timing - $last_timing}]
  66.  
  67.     case [lindex $event 1] in {
  68.     NOTEOFF {
  69.         set chan [lindex $event 3]
  70.         set pitch [lindex $event 5]
  71.         set vel [lindex $event 7]
  72.         midiput $mfile $track_num $delta noteoff $chan $pitch $vel
  73.     } NOTEON {
  74.         set chan [lindex $event 3]
  75.         set pitch [lindex $event 5]
  76.         set vel [lindex $event 7]
  77.         midiput $mfile $track_num $delta noteon $chan $pitch $vel
  78.     } KEY {
  79.         set chan [lindex $event 4]
  80.         set pitch [lindex $event 6]
  81.         set pres [lindex $event 8]
  82.         midiput $mfile $track_num $delta keypressure $chan $pitch $pres
  83.     } PARAMETER {
  84.         set chan [lindex $event 3]
  85.         set param [lindex $event 5]
  86.         set set [lindex $event 7]
  87.         midiput $mfile $track_num $delta parameter $chan $param $set
  88.     } PROGRAM {
  89.         set chan [lindex $event 3]
  90.         set prog [lindex $event 5]
  91.         midiput $mfile $track_num $delta program $chan $prog
  92.     } CHANNEL {
  93.         set chan [lindex $event 4]
  94.         set pres [lindex $event 6]
  95.         midiput $mfile $track_num $delta channelpressure $chan $pres
  96.     } PITCH {
  97.         set chan [lindex $event 4]
  98.         set val [lindex $event 6]
  99.         midiput $mfile $track_num $delta pitchwheel $chan $val
  100.     } METACHANPREFIX {
  101.         midiput $mfile $track_num $delta metachanprefix \
  102.             [lrange $event 2 end]
  103.     } METACPY {
  104.         midiput $mfile $track_num $delta metacpy [lrange $event 2 end]
  105.     } METACUE {
  106.         midiput $mfile $track_num $delta metacue [lrange $event 2 end]
  107.     } METAEOT {
  108.         midiput $mfile $track_num $delta metaeot
  109.     } METAINSTNAME {
  110.         midiput $mfile $track_num $delta metainstname \
  111.             [lrange $event 2 end]
  112.     } METAKEY {
  113.         midiput $mfile $track_num $delta metakey [lindex $event 2] \
  114.             [lindex $event 3]
  115.     } METALYRIC {
  116.         midiput $mfile $track_num $delta metalyric \
  117.             [lrange $event 2 end]
  118.     } METAMARKER {
  119.         midiput $mfile $track_num $delta metamarker \
  120.             [lrange $event 2 end]
  121.     } METASEQNAME {
  122.         midiput $mfile $track_num $delta metaseqname \
  123.             [lrange $event 2 end]
  124.     } METASEQNUM {
  125.         midiput $mfile $track_num $delta metaseqnum [lindex $event 2]
  126.     } METASEQSPEC {
  127.         # no idea, so we skip it
  128.         return $last_timing
  129.     } METASMPTE {
  130.         set hr [string trimright [lindex $event 3] ,]
  131.         set mi [string trimright [lindex $event 5] ,]
  132.         set se [string trimright [lindex $event 7] ,]
  133.         set fr [string trimright [lindex $event 9] ,]
  134.         set ff [lindex $event 12]
  135.         midiput $mfile $track_num $delta metasmpte $hr $mi $se $fr $ff
  136.     } METATEMPO {
  137.         midiput $mfile $track_num $delta metatempo [lindex $event 2]
  138.     } METATEXT {
  139.         midiput $mfile $track_num $delta metatext [lrange $event 2 end]
  140.     } METATIME {
  141.         set fraction [split [lindex $event 2] /]
  142.         set num [lindex $fraction 0]
  143.         set den [lindex $fraction 1]
  144.         set cpm [lindex $event 3]
  145.         set _32 [lindex $event 8]
  146.         midiput $mfile $track_num $delta metatime $num $den $cpm $_32
  147.     } SYSEX {
  148.         if {[string compare [lindex $event 2] cont] == 0} {
  149.             midiput $mfile $track_num $delta sysex cont \
  150.                 [lrange $event 3 end]
  151.         } else {
  152.             midiput $mfile $track_num $delta sysex \
  153.                 [lrange $event 2 end]
  154.         }
  155.     }
  156.     }
  157.  
  158.     return $timing
  159. }
  160.  
  161. if {[string compare $infile_name stdin] == 0} {
  162.     set infile stdin
  163. } else {
  164.     if {![file exists $infile_name]} then {
  165.         puts stderr "Bad file name: $infile_name"
  166.         exit 1
  167.     } else {
  168.         set infile [open $infile_name "r"]
  169.     }
  170. }
  171.  
  172. if {[string compare $outfile_name stdout] == 0} {
  173.     set outfile stdout
  174. } else {
  175.     # check to see if the specified file exists and open it
  176.     if {[catch {open $outfile_name "w"} outfile]} {
  177.         puts stderr "Couldn't open $midi_file_name for writing"
  178.         puts stderr $outfile
  179.     }
  180. }
  181.  
  182. # make an empty mfile
  183. set mfile [midimake]
  184.  
  185. # skip over filename since we use the command line
  186. if {[gets $infile line] == -1} {
  187.     puts stderr "bad input line: $junk"
  188.     exit 1
  189. }
  190.  
  191. # get format
  192. if {[gets $infile line] == -1} {
  193.     puts stderr "bad input line: $junk"
  194.     exit 1
  195. }
  196. set format [lindex $line 2]
  197. midiconfig $mfile format $format
  198.  
  199. # get division
  200. if {[gets $infile line] == -1} {
  201.     puts stderr "bad input line: $junk"
  202.     exit 1
  203. }
  204. set division [lindex $line 2]
  205. midiconfig $mfile division $division
  206.  
  207. # get num_trks
  208. if {[gets $infile line] == -1} {
  209.     puts stderr "bad input line: $junk"
  210.     exit 1
  211. }
  212. set num_trks [lindex $line 4]
  213. midiconfig $mfile tracks $num_trks
  214.  
  215. # generate all the tracks
  216. set track 0
  217. while {1} {
  218.     if {[gets $infile line] == -1} {
  219.         if {[expr {$num_trks - 1}] != $track} {
  220.             puts stderr "bad input line: $junk"
  221.             exit 1
  222.         } else {
  223.             break
  224.         }
  225.     }
  226.     if {[string compare [lindex $line 0] Track] == 0} {
  227.         set timing 0
  228.         set track [lindex $line 1]
  229.         continue
  230.     }
  231.     if {[string length $line] == 0} {
  232.         continue
  233.     }
  234.     set timing [PutEvent $line $mfile $track $timing]
  235. }
  236. midiwrite $mfile $outfile
  237. midifree $mfile
  238. close $outfile
  239. close $infile
  240. exit 0
  241.